home *** CD-ROM | disk | FTP | other *** search
/ START Magazine / START VOL 3 NO 7.st / KILLER.ARC / KILLER.LST next >
Encoding:
File List  |  1988-11-11  |  16.5 KB  |  748 lines
  1. ' *****************************************************************************
  2. ' *    KILLER CHESS ST - A translation of the Atari 8-bit Action! version     *
  3. ' *                      By Greg "Crazed Iguana" Knauss                       *
  4. ' *                     Copyright 1988  Antic Publishing                      *
  5. ' *****************************************************************************
  6. '
  7. ' Set up two screens for page flipping
  8. '
  9. Gosub Allocate_screens
  10. '
  11. ' *****************************************************************************
  12. ' Make sure the computer's in low resolution
  13. ' *****************************************************************************
  14. '
  15. '
  16. Orig_res%=Xbios(4)
  17. If Orig_res%=2 Then
  18.   Alert 1,"|Killer Chess can only|run on a color monitor...|",1,"Shucks!",X
  19.   End
  20. Endif
  21. '
  22. If (Not Exist("killscrn")) Or (Not Exist("killsets"))
  23.   Alert 1,"KILLSCRN and KILLSETS must|be in the same directory|as KILLER.PRG",1,"Abort",D
  24.   End
  25. Endif
  26. '
  27. ' Switch to low resolution (This, unfortunatly, does funny things to the COLOR
  28. ' command, so both player's cursors come up grey if they start the game from
  29. ' medium resolution.)
  30. '
  31. Void Xbios(5,L:Physbase%,L:Logbase%,0)
  32. '
  33. ' *****************************************************************************
  34. ' Do dem DIMs (And other assorted start-up stuff)
  35. ' *****************************************************************************
  36. '
  37. Hidem
  38. Dim Spalette%(16,3)
  39. @Save_pal
  40. For I=0 To 15
  41.   Setcolor I,1911
  42. Next I
  43. '
  44. Dim Piece$(6,1,1,2)
  45. Dim Set(1)
  46. Dim X(1)
  47. Dim Y(1)
  48. Dim Ox(1)
  49. Dim Oy(1)
  50. Dim Bord(7,7)
  51. Dim Hold(1)
  52. Dim Pau(1)
  53. Dim Nte(1)
  54. Dim Oct(1)
  55. Dim Joy(1)
  56. Nte(0)=6
  57. Oct(0)=4
  58. Nte(1)=6
  59. Oct(1)=4
  60. '
  61. ' *****************************************************************************
  62. ' The Holy Grail of STdom, the joystick init routine! Woo!
  63. ' (I don't understand how it works, I don't care how it works... I just care
  64. ' THAT it works.  Of course, the point is now moot, since GFA 3.0 has it's
  65. ' own joystick routines... Sigh.)
  66. ' *****************************************************************************
  67. '
  68. Mc$=Mki$(&H23C8)+Mkl$(*A%)+Mki$(&H4E75)
  69. V%=Xbios(34)+24
  70. O%=Lpeek(V%)
  71. Lpoke V%,Varptr(Mc$)
  72. A%=0
  73. Out 4,&H16
  74. Repeat
  75. Until A%
  76. Lpoke V%,O%
  77. Joy(0)=A%+1
  78. Joy(1)=A%+2
  79. Out 4,&H14
  80. '
  81. ' *****************************************************************************
  82. ' Get pieces out of KILLSETS file
  83. ' *****************************************************************************
  84. '
  85. Get 0,0,159,119,Screen$
  86. Bload "KILLSETS",Varptr(Screen$)
  87. Put 0,0,Screen$
  88. For K=0 To 2
  89.   For Plr=0 To 1
  90.     For I=0 To 1
  91.       For J=0 To 5
  92.         Get I*20+Plr*40+K*80,J*20,I*20+19+Plr*40+K*80,J*20+19,Piece$(J+1,Plr,I,K)
  93.       Next J
  94.     Next I
  95.   Next Plr
  96. Next K
  97. '
  98. ' *****************************************************************************
  99. ' Set up screen
  100. ' *****************************************************************************
  101. '
  102. Cls
  103. '
  104. ' Set screen colors
  105. '
  106. Setcolor 0,7,7,7       ! Background
  107. Setcolor 1,6,0,0       ! Red squares
  108. Setcolor 2,0,0,0       ! Black squares
  109. Setcolor 3,4,4,4       ! Border
  110. Setcolor 4,4,4,7       ! Player one cursor
  111. Setcolor 5,0,0,7       ! Player two cursor
  112. Setcolor 6,2,5,3       ! Dragon color one
  113. Setcolor 7,2,6,3       ! Dragon color two
  114. '
  115. ' Get screen from KILLSCRN
  116. '
  117. Sget Screen$
  118. Bload "KILLSCRN",Varptr(Screen$)
  119. Sput Screen$
  120. Gosub Copy_screen(1,2)
  121. '
  122. ' ******************************************************************************
  123. ' Board set ups and pieces colors
  124. ' ******************************************************************************
  125. '
  126. Set_data:
  127. '
  128. ' Set 1
  129. '
  130. Data 2,1,0,0,0,0,7,8
  131. Data 3,1,0,0,0,0,7,9
  132. Data 4,1,0,0,0,0,7,10
  133. Data 5,1,0,0,0,0,7,11
  134. Data 6,1,0,0,0,0,7,12
  135. Data 4,1,0,0,0,0,7,10
  136. Data 3,1,0,0,0,0,7,9
  137. Data 2,1,0,0,0,0,7,8
  138. '
  139. ' Set 2
  140. '
  141. Data 2,0,0,7,1,0,0,8
  142. Data 3,0,0,7,1,0,0,9
  143. Data 4,0,0,7,1,0,0,10
  144. Data 5,0,0,7,1,0,0,11
  145. Data 6,0,0,7,1,0,0,12
  146. Data 4,0,0,7,1,0,0,10
  147. Data 3,0,0,7,1,0,0,9
  148. Data 2,0,0,7,1,0,0,8
  149. '
  150. ' Set 3
  151. '
  152. Data 0,0,0,0,0,0,0,0
  153. Data 1,1,0,0,0,0,7,7
  154. Data 4,3,1,0,0,7,9,10
  155. Data 5,2,1,0,0,7,8,11
  156. Data 6,2,1,0,0,7,8,12
  157. Data 4,3,1,0,0,7,9,10
  158. Data 1,1,0,0,0,0,7,7
  159. Data 0,0,0,0,0,0,0,0
  160. '
  161. ' Set 4
  162. '
  163. Data 5,1,1,0,0,7,7,12
  164. Data 1,1,0,0,0,0,7,7
  165. Data 1,0,3,0,0,9,0,7
  166. Data 0,0,0,0,0,0,0,0
  167. Data 0,0,0,0,0,0,0,0
  168. Data 1,0,9,0,0,3,0,7
  169. Data 1,1,0,0,0,0,7,7
  170. Data 6,1,1,0,0,7,7,11
  171. '
  172. Piece_colors_1:
  173. '
  174. Data 1092,1365,1638,1911
  175. Data 1365,1328,1891,1814
  176. '
  177. Piece_colors_2:
  178. '
  179. Data 546,819,1092,1365
  180. Data 1092,1891,832,1347
  181. '
  182. ' *****************************************************************************
  183. ' Squares
  184. ' *****************************************************************************
  185. '
  186. Get 126,6,145,25,Red$
  187. Get 152,6,171,25,Blk$
  188. '
  189. ' *****************************************************************************
  190. ' Game options
  191. ' *****************************************************************************
  192. '
  193. Start:
  194. '
  195. Screen_set_ups:
  196. Restore Set_data
  197. For K=0 To Screen
  198.   For I=0 To 7
  199.     For J=0 To 7
  200.       Read Bord(J,I)
  201.     Next J
  202.   Next I
  203. Next K
  204. '
  205. Prnt_pieces:
  206. '
  207. ' Put up the blank board
  208. '
  209. Sput Screen$
  210. '
  211. ' Copy it to second screen
  212. '
  213. Gosub Copy_screen(1,2)
  214. '
  215. ' Set colors
  216. '
  217. Restore Piece_colors_1
  218. For L=0 To Set(0)
  219.   For I=8 To 11
  220.     Read J
  221.     Setcolor I,J
  222.   Next I
  223. Next L
  224. '
  225. Restore Piece_colors_2
  226. For L=0 To Set(1)
  227.   For I=12 To 15
  228.     Read J
  229.     Setcolor I,J
  230.   Next I
  231. Next L
  232. '
  233. ' Put pieces on board
  234. '
  235. Gosub Set_screen
  236. For I=0 To 7
  237.   For J=0 To 7
  238.     If Bord(J,I)<>0 Then
  239.       Put J*24+126,I*24+6,Piece$(Bord(J,I)+6*(Bord(J,I)>6),-(Bord(J,I)>6),-((I+J)/2=Int((I+J)/2)),Set(-(Bord(J,I)>6)))
  240.     Endif
  241.   Next J
  242. Next I
  243. Gosub Add_screen
  244. Deftext 3,0,0,4
  245. Text 15,150,"<SPACE> TO START"
  246. Text 23,157,"<ESC> TO EXIT"
  247. '
  248. Repeat
  249.   '
  250.   ' Game options
  251.   '
  252.   I=Inp(2)
  253.   '
  254.   ' Different board set ups
  255.   '
  256.   If I=27 Then
  257.     Gosub Finished
  258.   Endif
  259.   '
  260.   If I=187 Then
  261.     Screen=Screen+1
  262.     If Screen=4 Then
  263.       Screen=0
  264.     Endif
  265.     Goto Screen_set_ups
  266.   Endif
  267.   '
  268.   ' Different pieces
  269.   '
  270.   J=0
  271.   Repeat
  272.     If I=188+J Then
  273.       Set(J)=Set(J)+1
  274.       If Set(J)=2 Then
  275.         Set(J)=0
  276.       Endif
  277.       Goto Prnt_pieces
  278.     Endif
  279.     J=J+1
  280.   Until J=2
  281.   '
  282. Until I=32
  283. '
  284. ' *****************************************************************************
  285. ' Inits
  286. ' *****************************************************************************
  287. '
  288. Plr=0
  289. X(0)=0
  290. Y(0)=3
  291. X(1)=7
  292. Y(1)=3
  293. Hold(0)=0
  294. Hold(1)=0
  295. Pau(0)=0
  296. Pau(1)=0
  297. '
  298. ' *****************************************************************************
  299. ' And they're off!
  300. ' *****************************************************************************
  301. '
  302. ' Game loop
  303. '
  304. Deftext 3,0,0,4
  305. Text 15,150,"                "
  306. Text 23,157,"             "
  307. Interupted!=False
  308. Do
  309.   '
  310.   ' Set up all the stuff for page-flipping
  311.   '
  312.   Gosub Set_screen
  313.   Text 30,152,"<SPACE> TO"
  314.   Text 35,159,"QUIT GAME"
  315.   '
  316.   B=Peek(Joy(Plr))
  317.   '
  318.   Interupted!=(Asc(Inkey$)=32)
  319.   Exit If Interupted!
  320.   '
  321.   ' They're moving
  322.   '
  323.   If B And 15 Then
  324.     '
  325.     ' Do da movement
  326.     '
  327.     X1=0
  328.     Y1=0
  329.     If B And 1 And Y(Plr)>0 Then
  330.       Y1=-1
  331.     Endif
  332.     If B And 2 And Y(Plr)<7 Then
  333.       Y1=1
  334.     Endif
  335.     If B And 4 And X(Plr)>0 Then
  336.       X1=-1
  337.     Endif
  338.     If B And 8 And X(Plr)<7 Then
  339.       X1=1
  340.     Endif
  341.     '
  342.     ' Erase old cursor and move
  343.     '
  344.     If X1<>0 Or Y1<>0 Then
  345.       Gosub Erase
  346.       X(Plr)=X(Plr)+X1
  347.       Y(Plr)=Y(Plr)+Y1
  348.     Endif
  349.   Endif
  350.   '
  351.   ' Redraw cursor
  352.   '
  353.   Color 4+Plr*3
  354.   Box X(Plr)*24+124,Y(Plr)*24+4,X(Plr)*24+124+23,Y(Plr)*24+27
  355.   Box X(Plr)*24+125,Y(Plr)*24+5,X(Plr)*24+124+22,Y(Plr)*24+26
  356.   '
  357.   ' ***********************************************************************
  358.   ' Did they pick up/put down a piece?
  359.   ' ***********************************************************************
  360.   '
  361.   If B>127 And Pau(Plr)=0 Then
  362.     '
  363.     ' Pick up
  364.     '
  365.     If Hold(Plr)=0 Then
  366.       If Bord(X(Plr),Y(Plr))>=Plr*6+1 And Bord(X(Plr),Y(Plr))<=Plr*6+6 Then
  367.         Hold(Plr)=Bord(X(Plr),Y(Plr))
  368.         Ox(Plr)=X(Plr)
  369.         Oy(Plr)=Y(Plr)
  370.         Put 4+91*Plr,176,Piece$((Bord(X(Plr),Y(Plr))-Plr*6),Plr,0,Set(-(Bord(X(Plr),Y(Plr))>6)))
  371.         Pau(Plr)=5
  372.       Endif
  373.     Else
  374.       Pau(Plr)=5
  375.       '
  376.       ' Set it down
  377.       '
  378.       ' Are they on top of something?
  379.       '
  380.       Cap=0
  381.       If Bord(X(Plr),Y(Plr))>0 Then
  382.         Cap=1
  383.       Endif
  384.       '
  385.       ' *********************************************************************
  386.       ' Check for legal move!
  387.       ' *********************************************************************
  388.       '
  389.       Ok=0
  390.       '
  391.       ' Get delta values
  392.       '
  393.       Dx=X(Plr)-Ox(Plr)
  394.       Dy=Y(Plr)-Oy(Plr)
  395.       '
  396.       ' Flip for black player
  397.       '
  398.       If Plr=1 Then
  399.         Dx=-Dx
  400.         Dy=-Dy
  401.       Endif
  402.       '
  403.       ' Pawn
  404.       '
  405.       If Hold(Plr)=1+Plr*6 Then
  406.         If Dx=1 And Dy=0 And Cap=0 Then
  407.           Ok=1
  408.         Endif
  409.         If Dx=2 And Dy=0 And Cap=0 And Ox(Plr)=1+5*Plr And Screen=0 Then
  410.           Ok=1
  411.         Endif
  412.         If Dx=1 And (Dy=1 Or Dy=-1) And Cap=1 Then
  413.           Ok=1
  414.         Endif
  415.       Endif
  416.       '
  417.       ' Rook
  418.       '
  419.       If Hold(Plr)=2+Plr*6 Then
  420.         If (Dx<>0 And Dy=0) Or (Dx=0 And Dy<>0) Then
  421.           Ok=1
  422.         Endif
  423.       Endif
  424.       '
  425.       ' Knight
  426.       '
  427.       If Hold(Plr)=3+Plr*6 Then
  428.         If (Dx=2 And Dy=1) Or (Dx=-2 And Dy=1) Then
  429.           Ok=1
  430.         Endif
  431.         If (Dx=2 And Dy=-1) Or (Dx=-2 And Dy=-1) Then
  432.           Ok=1
  433.         Endif
  434.         If (Dx=1 And Dy=2) Or (Dx=-1 And Dy=2) Then
  435.           Ok=1
  436.         Endif
  437.         If (Dx=1 And Dy=-2) Or (Dx=-1 And Dy=-2) Then
  438.           Ok=1
  439.         Endif
  440.       Endif
  441.       '
  442.       ' Bishop
  443.       '
  444.       If Hold(Plr)=4+Plr*6 Then
  445.         If Dx=Dy Or Dx=-Dy Then
  446.           Ok=1
  447.         Endif
  448.       Endif
  449.       '
  450.       ' King
  451.       '
  452.       If Hold(Plr)=5+Plr*6 Then
  453.         If (Dx=1 And Dy=1) Or (Dx=0 And Dy=1) Or (Dx=-1 And Dy=1) Then
  454.           Ok=1
  455.         Endif
  456.         If (Dx=1 And Dy=0) Or (Dx=0 And Dy=0) Or (Dx=-1 And Dy=0) Then
  457.           Ok=1
  458.         Endif
  459.         If (Dx=1 And Dy=-1) Or (Dx=0 And Dy=-1) Or (Dx=-1 And Dy=-1) Then
  460.           Ok=1
  461.         Endif
  462.       Endif
  463.       '
  464.       ' Queen
  465.       '
  466.       If Hold(Plr)=6+Plr*6 Then
  467.         If Dx=Dy Or Dx=-Dy Then
  468.           Ok=1
  469.         Endif
  470.         If (Dx<>0 And Dy=0) Or (Dx=0 And Dy<>0) Then
  471.           Ok=1
  472.         Endif
  473.       Endif
  474.       '
  475.       ' They tried to capture one of their own pieces... Duh.
  476.       '
  477.       If Bord(X(Plr),Y(Plr))>=Plr*6+1 And Bord(X(Plr),Y(Plr))<=Plr*6+6 Then
  478.         Ok=0
  479.       Endif
  480.       '
  481.       ' They didn't move...
  482.       '
  483.       If Dx=0 And Dy=0 Then
  484.         Ok=1
  485.       Endif
  486.       '
  487.       ' Make sure they didn't jump pieces except with knight
  488.       '
  489.       If Hold(Plr)<>3+6*Plr Then
  490.         I=Ox(Plr)
  491.         J=Oy(Plr)
  492.         X1=0
  493.         Y1=0
  494.         If Dx<0 Then
  495.           X1=-1
  496.         Else
  497.           If Dx>0 Then
  498.             X1=1
  499.           Endif
  500.         Endif
  501.         If Dy<0 Then
  502.           Y1=-1
  503.         Else
  504.           If Dy>0 Then
  505.             Y1=1
  506.           Endif
  507.         Endif
  508.         If Plr=1 Then
  509.           X1=-X1
  510.           Y1=-Y1
  511.         Endif
  512.         If Dx<-1 Or Dx>1 Or Dy<-1 Or Dy>1 Then
  513.           Repeat
  514.             I=I+X1
  515.             J=J+Y1
  516.             If Bord(I,J)<>0 Then
  517.               Ok=0
  518.             Endif
  519.           Until (I=X(Plr)-X1 And J=Y(Plr)-Y1) Or I=0 Or I=7 Or J=0 Or J=7
  520.         Endif
  521.       Endif
  522.       '
  523.       ' Legal move!
  524.       '
  525.       If Ok=1 Then
  526.         '
  527.         ' Queen me!
  528.         '
  529.         If Hold(Plr)=1+6*Plr And X(Plr)=7-7*Plr Then
  530.           Hold(Plr)=6+6*Plr
  531.         Endif
  532.         '
  533.         ' Kill other players HOLD if that's what was caught
  534.         '
  535.         If X(Plr)=Ox(1-Plr) And Y(Plr)=Oy(1-Plr) Then
  536.           Hold(1-Plr)=0
  537.           Put 4+91*(1-Plr),176,Blk$
  538.         Endif
  539.         '
  540.         ' Erase old piece and draw new one
  541.         '
  542.         A$=Blk$
  543.         If (Ox(Plr)+Oy(Plr))/2=Int((Ox(Plr)+Oy(Plr))/2) Then
  544.           A$=Red$
  545.         Endif
  546.         Put Ox(Plr)*24+126,Oy(Plr)*24+6,A$
  547.         Put X(Plr)*24+126,Y(Plr)*24+6,Piece$(Hold(Plr)-6*Plr,Plr,-((X(Plr)+Y(Plr))/2=Int((X(Plr)+Y(Plr))/2)),Set(Plr))
  548.         '
  549.         ' Was the captured piece the other guy's king?
  550.         '
  551.         If Bord(X(Plr),Y(Plr))=11-Plr*6 Then
  552.           Bord(X(Plr),Y(Plr))=Hold(Plr)
  553.           Goto Finis
  554.         Endif
  555.         '
  556.         ' Make change in memory
  557.         '
  558.         Bord(Ox(Plr),Oy(Plr))=0
  559.         Bord(X(Plr),Y(Plr))=Hold(Plr)
  560.         '
  561.         ' Erase HOLD
  562.         '
  563.         Hold(Plr)=0
  564.         Deffill 0
  565.         Put 4+91*Plr,176,Blk$
  566.         '
  567.         Nte(Plr)=6
  568.         Oct(Plr)=4
  569.       Else
  570.         '
  571.         ' Illegal move...
  572.         '
  573.         Nte(Plr)=2
  574.         Oct(Plr)=1
  575.       Endif
  576.     Endif
  577.   Endif
  578.   '
  579.   ' Decrease pause value
  580.   '
  581.   If Pau(Plr)>0 Then
  582.     Sound Plr,Pau(Plr)*3,Nte(Plr),Oct(Plr)
  583.     Pau(Plr)=Pau(Plr)-1
  584.   Else
  585.     Sound Plr,0,0,0
  586.   Endif
  587.   '
  588.   ' On to the next player
  589.   '
  590.   Plr=1-Plr
  591.   '
  592.   ' Flip to what we've been drawing, so the animation looks quick
  593.   '
  594.   Gosub Add_screen
  595.   '
  596. Loop
  597. '
  598. ' *****************************************************************************
  599. ' Game over
  600. ' *****************************************************************************
  601. '
  602. Finis:
  603. '
  604. ' Erase the HOLDs and cursors
  605. '
  606. Put 4+91*Plr,176,Blk$
  607. Gosub Erase
  608. Plr=1-Plr
  609. Put 4+91*Plr,176,Blk$
  610. Gosub Erase
  611. '
  612. If Not Interupted!
  613.   ' Clear all the losers pieces off the board
  614.   '
  615.   For I=0 To 7
  616.     For J=0 To 7
  617.       If Bord(J,I)>Plr*6 And Bord(J,I)<(Plr*6)+7 Then
  618.         A$=Blk$
  619.         If (I+J)/2=Int((I+J)/2) Then
  620.           A$=Red$
  621.         Endif
  622.         Put J*24+126,I*24+6,A$
  623.       Endif
  624.     Next J
  625.   Next I
  626.   '
  627.   ' Flip!
  628.   '
  629.   Gosub Add_screen
  630.   '
  631.   ' Yawn...
  632.   '
  633.   Pause 250
  634.   '
  635. Else
  636.   Pause 50
  637.   Gosub Add_screen
  638. Endif
  639. '
  640. Goto Start
  641. '
  642. Procedure Finished
  643.   Out 4,8
  644.   @Restorepal
  645.   Void Xbios(5,L:Physbase%,L:Logbase%,Orig_res%)
  646.   End
  647. Return
  648. '
  649. ' *****************************************************************************
  650. ' Routine to erase PLRs cursor
  651. ' *****************************************************************************
  652. '
  653. Procedure Erase
  654.   Color 3
  655.   If (X(Plr)+Y(Plr))/2=Int((X(Plr)+Y(Plr))/2) Then
  656.     Color 2
  657.   Endif
  658.   Box X(Plr)*24+124,Y(Plr)*24+4,X(Plr)*24+124+23,Y(Plr)*24+27
  659.   Box X(Plr)*24+125,Y(Plr)*24+5,X(Plr)*24+124+22,Y(Plr)*24+26
  660. Return
  661. '
  662. ' *****************************************************************************
  663. '   Heaping shovelfuls of thanks to Helvetica Bold for teaching my all about
  664. '   page-flipping on the ST.  He wouldn't let me form a religion around him,
  665. '   however.
  666. ' *****************************************************************************
  667. '
  668. ' Do the initial set ups
  669. '
  670. Procedure Allocate_screens
  671.   '
  672.   ' Save original screen settings:
  673.   '
  674.   Physbase%=Xbios(2)
  675.   Logbase%=Xbios(3)
  676.   '
  677.   Dim Screen$(2),Screen%(2)
  678.   '
  679.   ' Set up two screens in memory.  More are just as easy.  Each needs to be
  680.   ' on a 512 byte boundry, so dimension a string to 32512 bytes and then
  681.   ' move to the boundry.
  682.   '
  683.   Screen%(1)=Physbase%
  684.   Screen$(2)=Space$(32512)
  685.   Screen%(2)=(Int(Varptr(Screen$(2))/512)+1)*512
  686.   '
  687.   ' Copy screen one to screen two.
  688.   '
  689.   @Copy_screen(1,2)
  690. Return
  691. '
  692. ' Set up for page-flip
  693. '
  694. Procedure Set_screen
  695.   Vsync
  696.   Void Xbios(5,L:Screen%(2),L:Screen%(1),-1)
  697. Return
  698. '
  699. ' Do the flip
  700. '
  701. Procedure Add_screen
  702.   Void Xbios(5,L:Screen%(1),L:Screen%(2),-1)
  703.   Gosub Copy_screen(2,1)
  704.   Void Xbios(5,L:Screen%(1),L:Screen%(1),-1)
  705. Return
  706. '
  707. ' Generic copy screen
  708. '
  709. Procedure Copy_screen(Source%,Dest%)
  710.   Vsync
  711.   Bmove Screen%(Source%),Screen%(Dest%),32000
  712. Return
  713. '
  714. ' ------------- SAVE ORIGINAL COLOR PALETTE -----------------------
  715. Procedure Save_pal
  716.   '
  717.   ' Requires Dim Spalette%(16,3)
  718.   '
  719.   For Z%=0 To 15
  720.     Dpoke Contrl,26
  721.     Dpoke Contrl+2,0
  722.     Dpoke Contrl+6,2
  723.     Dpoke Intin,Z%
  724.     Dpoke Intin+2,0
  725.     Vdisys
  726.     Spalette%(Z%,0)=Dpeek(Intout+2)
  727.     Spalette%(Z%,1)=Dpeek(Intout+4)
  728.     Spalette%(Z%,2)=Dpeek(Intout+6)
  729.   Next Z%
  730. Return
  731. '
  732. Procedure Restorepal
  733.   ' --------------------- RESTORES PALLET -------------------
  734.   ' Dimensions: Spalette%(16,3)
  735.   '
  736.   For Z%=0 To 15
  737.     Dpoke Contrl,14
  738.     Dpoke Contrl+2,0
  739.     Dpoke Contrl+6,4
  740.     Dpoke Intin,Z%
  741.     Dpoke Intin+2,Spalette%(Z%,0)
  742.     Dpoke Intin+4,Spalette%(Z%,1)
  743.     Dpoke Intin+6,Spalette%(Z%,2)
  744.     Vdisys
  745.   Next Z%
  746. Return
  747. '
  748.